Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH8/SRC/RNDTREE.FRM

Visual Basic Form | 1996-03-05 | 9.0 KB | 307 lines

VERSION 4.00
Begin VB.Form RndTreeForm
   Caption         =   "Randomized Tree"
   ClientHeight    =   4335
   ClientLeft      =   1140
   ClientTop       =   1335
   ClientWidth     =   7470
   Height          =   5025
   Left            =   1080
   LinkTopic       =   "Form1"
   ScaleHeight     =   289
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   498
   Top             =   705
   Width           =   7590
   Begin VB.TextBox RndDThetaText
      Height          =   285
      Left            =   1320
      MaxLength       =   3
      TabIndex        =   14
      Text            =   "10"
      Top             =   1800
      Width           =   615
   End
   Begin VB.CheckBox BendCheck
      Caption         =   "Bend Branches"
      Height          =   255
      Left            =   240
      TabIndex        =   13
      Top             =   2640
      Width           =   1455
   End
   Begin VB.TextBox MaxBranchesText
      Height          =   285
      Left            =   1320
      MaxLength       =   3
      TabIndex        =   11
      Text            =   "3"
      Top             =   360
      Width           =   615
   End
   Begin VB.TextBox RndScaleText
      Height          =   285
      Left            =   1320
      MaxLength       =   5
      TabIndex        =   9
      Text            =   "0.20"
      Top             =   1080
      Width           =   615
   End
   Begin VB.TextBox DThetaText
      Height          =   285
      Left            =   1320
      MaxLength       =   3
      TabIndex        =   2
      Text            =   "36"
      Top             =   1440
      Width           =   615
   End
   Begin VB.TextBox ScaleText
      Height          =   285
      Left            =   1320
      MaxLength       =   5
      TabIndex        =   1
      Text            =   "0.75"
      Top             =   720
      Width           =   615
   End
   Begin VB.TextBox LevelText
      Height          =   285
      Left            =   1320
      MaxLength       =   3
      TabIndex        =   0
      Text            =   "5"
      Top             =   0
      Width           =   615
   End
   Begin VB.CheckBox TaperCheck
      Caption         =   "Taper Branches"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   2280
      Width           =   1455
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      Height          =   4335
      Left            =   2040
      ScaleHeight     =   285
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   357
      TabIndex        =   6
      Top             =   0
      Width           =   5415
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   495
      Left            =   600
      TabIndex        =   4
      Top             =   3120
      Width           =   735
   End
   Begin VB.Label Label1
      Caption         =   "Rnd DTheta"
      Height          =   255
      Index           =   3
      Left            =   0
      TabIndex        =   15
      Top             =   1800
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "Max Branches"
      Height          =   255
      Index           =   5
      Left            =   0
      TabIndex        =   12
      Top             =   360
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "Rnd Scale"
      Height          =   255
      Index           =   4
      Left            =   0
      TabIndex        =   10
      Top             =   1080
      Width           =   1335
   End
   Begin MSComDlg.CommonDialog FileDialog
      Left            =   720
      Top             =   3720
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
   End
   Begin VB.Label Label1
      Caption         =   "DTHETA"
      Height          =   255
      Index           =   2
      Left            =   0
      TabIndex        =   8
      Top             =   1440
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "LENGTH_SCALE"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   7
      Top             =   720
      Width           =   1335
   End
   Begin VB.Label Label1
      Caption         =   "Level"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   5
      Top             =   0
      Width           =   1335
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "RndTreeForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const PI = 3.14159
Const PI_2 = PI / 2
Const PI_5 = PI / 5
Dim LengthScale As Single
Dim RndScale As Single
Dim DTheta As Single
Dim RndDTheta As Single
Dim MaxBranches As Integer
Dim TheLevel As Integer
Dim StartX As Integer
Dim StartY As Integer
Dim StartLength As Integer
' ************************************************
' Recursively draw a tree branch.
' ************************************************
Sub DrawBranch(bend As Single, thickness As Integer, level As Integer, x As Integer, y As Integer, length As Integer, theta As Single)
Const DIST_PER_BEND = 5#
Const BEND_FACTOR = 2#
Const MAX_BEND = PI / 6
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim status As Integer
Dim num_bends As Integer
Dim num_branches As Integer
Dim i As Integer
Dim new_length As Integer
Dim new_theta As Single
Dim new_bend As Single
Dim dt As Single
Dim t As Single
    If thickness > 0 Then Canvas.DrawWidth = thickness
    ' Draw the branch.
    If bend > 0 Then
        ' This is a bending branch.
        num_bends = length / DIST_PER_BEND
        t = theta
        x1 = x
        y1 = y
        For i = 1 To num_bends
            x2 = x1 + DIST_PER_BEND * Cos(t)
            y2 = y1 + DIST_PER_BEND * Sin(t)
            Canvas.Line (x1, y1)-(x2, y2)

            t = t + bend * (Rnd - 0.5)
            x1 = x2
            y1 = y2
        Next i
    Else
        ' This is a straight branch.
        x1 = x + length * Cos(theta)
        y1 = y + length * Sin(theta)
        Canvas.Line (x, y)-(x1, y1)
    End If
    ' If level > 1, draw the attached branches.
    If level > 1 Then
        num_branches = Int((MaxBranches - 1) * Rnd + 2)
        dt = 2 * DTheta / (num_branches - 1)
        t = theta - DTheta
        For i = 1 To num_branches
            new_length = length * (LengthScale + RndScale * (Rnd - 0.5))
            new_theta = t + RndDTheta * (Rnd - 0.5)
            t = t + dt
            If bend > 0 Then
                new_bend = bend * BEND_FACTOR
                If new_bend > MAX_BEND Then new_bend = MAX_BEND
            Else
                new_bend = bend
            End If
            DrawBranch new_bend, thickness - 1, level - 1, x1, y1, new_length, new_theta
        Next i
    End If
End Sub
Private Sub CmdGo_Click()
Dim taper As Integer
Dim bend As Single
    Canvas.Cls
    MousePointer = vbHourglass
    DoEvents
    ' Get the tree parameters.
    If Not IsNumeric(LevelText.Text) Then _
        LevelText.Text = "5"
    TheLevel = CInt(LevelText.Text)
    If Not IsNumeric(ScaleText.Text) Then _
        ScaleText.Text = "0.75"
    LengthScale = CSng(ScaleText.Text)
    If Not IsNumeric(DThetaText.Text) Then _
        DThetaText.Text = "36"
    DTheta = CSng(DThetaText.Text) * PI / 180#
    If Not IsNumeric(RndScaleText.Text) Then _
        RndScaleText.Text = "0.2"
    RndScale = CSng(RndScaleText.Text)
    If Not IsNumeric(RndDThetaText.Text) Then _
        RndDThetaText.Text = "20"
    RndDTheta = CSng(RndDThetaText.Text) * PI / 180#
    If Not IsNumeric(MaxBranchesText.Text) Then _
        MaxBranchesText.Text = "3"
    MaxBranches = CInt(MaxBranchesText.Text)
    If TaperCheck.Value = vbChecked Then
        taper = TheLevel
    Else
        taper = 0
    End If
    If BendCheck.Value = vbChecked Then
        bend = PI / 90
    Else
        bend = 0
    End If
    StartLength = (Canvas.ScaleHeight - 10) / _
        ((1 - LengthScale ^ (TheLevel + 1)) / (1 - LengthScale))
    ' Draw the tree.
    DrawBranch bend, taper, TheLevel, StartX, StartY, StartLength, -PI_2
    MousePointer = vbDefault
End Sub
Private Sub Form_Load()
    Randomize
    TheLevel = CInt(LevelText.Text)
End Sub
Private Sub Form_Resize()
    Canvas.Move Canvas.Left, 0, _
        ScaleWidth - Canvas.Left, ScaleHeight - 1
    StartX = Canvas.ScaleWidth \ 2
    StartY = Canvas.ScaleHeight - 5
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub